home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / plists.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  2KB  |  58 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defmodule plists (standard0) ()
  8.  
  9.   (deflocal main-table (make-table eq))
  10.  
  11.   (defun put (id key val)
  12.     (let ((prop-table (or 
  13.                 (table-ref main-table id)
  14.             (progn
  15.               ((setter table-ref) main-table id (make-table eq))
  16.               (table-ref main-table id)))))
  17.       ((setter table-ref) prop-table key val)
  18.       val))
  19.  
  20.   (export put)
  21.  
  22.   (defun get (id key)
  23.     (let ((tab (table-ref main-table id)))
  24.       (if (null tab) nil
  25.     (table-ref tab key))))
  26.  
  27.   (export get)
  28.  
  29.   ((setter setter) get put)
  30.  
  31.   (defun remprop (id key)
  32.     (let ((tab (table-ref main-table id)))
  33.       (if (null tab) nil
  34.     (let ((ans (table-ref tab key)))
  35.                     ; May be a new table
  36.       ;;((setter table-ref) main-table id (table-delete tab key))
  37.       ans))))
  38.  
  39.   (export remprop)
  40.  
  41.   (defun symbol-props (id)
  42.     (let ((tab (table-ref main-table id)))
  43.       (if (null tab) nil
  44.     (let ((ans nil))
  45.       (map-table
  46.          (lambda (tag prop) (setq ans (cons tag (cons prop ans))))
  47.          tab)
  48.       ans))))
  49.  
  50.   (defun table-delete (t x)
  51.     ((setter table-ref) t x nil))
  52.  
  53.   (defun kill-props (id)
  54.     ((setter table-ref) main-table id nil))
  55.  
  56.   (export symbol-props kill-props)
  57. )
  58.